home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / lib / hashtbl.ml < prev    next >
Encoding:
Text File  |  1994-07-07  |  2.8 KB  |  112 lines  |  [TEXT/MPS ]
  1. (* Hash tables *)
  2.  
  3. #open "exc";;
  4. #open "int";;
  5. #open "eq";;
  6. #open "fvect";;
  7. #open "ref";;
  8.  
  9. (* We do dynamic hashing, and we double the size of the table when
  10.    buckets become too long, but without re-hashing the elements. *)
  11.  
  12. type ('a, 'b) t =
  13.   { mutable max_len: int;                    (* max length of a bucket *)
  14.     mutable data: ('a, 'b) bucketlist vect } (* the buckets *)
  15.  
  16. and ('a, 'b) bucketlist =
  17.     Empty
  18.   | Cons of 'a * 'b * ('a, 'b) bucketlist
  19. ;;
  20.  
  21. let new initial_size =
  22.   { max_len = 2; data = make_vect initial_size Empty }
  23. ;;
  24.  
  25. let clear h =
  26.   for i = 0 to vect_length h.data - 1 do
  27.     h.data.(i) <- Empty
  28.   done
  29. ;;
  30.  
  31. let resize h =
  32.   let n = vect_length h.data in
  33.   let newdata = make_vect (n+n) Empty in
  34.     blit_vect h.data 0 newdata 0 n;
  35.     blit_vect h.data 0 newdata n n;
  36.     h.data <- newdata;
  37.     h.max_len <- 2 * h.max_len;
  38.     ()
  39. ;;
  40.  
  41. let rec bucket_too_long n bucket =
  42.   if n < 0 then true else
  43.     match bucket with
  44.       Empty -> false
  45.     | Cons(_,_,rest) -> bucket_too_long (pred n) rest
  46. ;;
  47.  
  48. let add h key info =
  49.   let i = (hash_param 10 100 key) mod (vect_length h.data) in
  50.   let bucket = Cons(key, info, h.data.(i)) in
  51.     h.data.(i) <- bucket;
  52.     if bucket_too_long h.max_len bucket then resize h
  53. ;;
  54.  
  55. let remove h key =
  56.   let rec remove_bucket = function
  57.       Empty ->
  58.         Empty
  59.     | Cons(k, i, next) ->
  60.         if k = key then next else Cons(k, i, remove_bucket next) in
  61.   let i = (hash_param 10 100 key) mod (vect_length h.data) in
  62.     h.data.(i) <- remove_bucket h.data.(i); ()
  63. ;;
  64.  
  65. let find h key =
  66.   match h.data.((hash_param 10 100 key) mod (vect_length h.data)) with
  67.     Empty -> raise Not_found
  68.   | Cons(k1, d1, rest1) ->
  69.       if key = k1 then d1 else
  70.       match rest1 with
  71.         Empty -> raise Not_found
  72.       | Cons(k2, d2, rest2) ->
  73.           if key = k2 then d2 else
  74.           match rest2 with
  75.             Empty -> raise Not_found
  76.           | Cons(k3, d3, rest3) ->
  77.               if key = k3 then d3 else begin
  78.                 let rec find = function
  79.                     Empty ->
  80.                       raise Not_found
  81.                   | Cons(k, d, rest) ->
  82.                       if key = k then d else find rest
  83.                 in find rest3
  84.               end
  85. ;;
  86.  
  87. let find_all h key =
  88.   let rec find_in_bucket = function
  89.     Empty ->
  90.       []
  91.   | Cons(k, d, rest) ->
  92.       if k = key then d :: find_in_bucket rest else find_in_bucket rest in
  93.   find_in_bucket h.data.((hash_param 10 100 key) mod (vect_length h.data))
  94. ;;
  95.  
  96. let do_table f h =
  97.   let len = vect_length h.data in
  98.   for i = 0 to vect_length h.data - 1 do
  99.     let rec do_bucket = function
  100.         Empty ->
  101.           ()
  102.       | Cons(k, d, rest) ->
  103.           if (hash_param 10 100 k) mod len == i
  104.           then begin f k d; do_bucket rest end
  105.           else do_bucket rest in
  106.     do_bucket h.data.(i)
  107.   done
  108. ;;
  109.  
  110. let hash x = hash_param 50 500 x
  111. ;;
  112.